home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2002 November / CD 1 / APC0211D1.ISO / workshop / prog / files / ActivePerl-5.6.1.633-MSWin32.msi / _3bf3ca8f7bdc5af34ce9029a6f08ae39 < prev    next >
Encoding:
Text File  |  2002-06-17  |  13.4 KB  |  451 lines

  1. package File::Glob;
  2.  
  3. use strict;
  4. use Carp;
  5. our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS,
  6.     $AUTOLOAD, $DEFAULT_FLAGS);
  7.  
  8. require Exporter;
  9. use XSLoader ();
  10. require AutoLoader;
  11.  
  12. @ISA = qw(Exporter AutoLoader);
  13.  
  14. # NOTE: The glob() export is only here for compatibility with 5.6.0.
  15. # csh_glob() should not be used directly, unless you know what you're doing.
  16.  
  17. @EXPORT_OK   = qw(
  18.     csh_glob
  19.     bsd_glob
  20.     glob
  21.     GLOB_ABEND
  22.     GLOB_ALPHASORT
  23.     GLOB_ALTDIRFUNC
  24.     GLOB_BRACE
  25.     GLOB_CSH
  26.     GLOB_ERR
  27.     GLOB_ERROR
  28.     GLOB_LIMIT
  29.     GLOB_MARK
  30.     GLOB_NOCASE
  31.     GLOB_NOCHECK
  32.     GLOB_NOMAGIC
  33.     GLOB_NOSORT
  34.     GLOB_NOSPACE
  35.     GLOB_QUOTE
  36.     GLOB_TILDE
  37. );
  38.  
  39. %EXPORT_TAGS = (
  40.     'glob' => [ qw(
  41.         GLOB_ABEND
  42.     GLOB_ALPHASORT
  43.         GLOB_ALTDIRFUNC
  44.         GLOB_BRACE
  45.         GLOB_CSH
  46.         GLOB_ERR
  47.         GLOB_ERROR
  48.         GLOB_LIMIT
  49.         GLOB_MARK
  50.         GLOB_NOCASE
  51.         GLOB_NOCHECK
  52.         GLOB_NOMAGIC
  53.         GLOB_NOSORT
  54.         GLOB_NOSPACE
  55.         GLOB_QUOTE
  56.         GLOB_TILDE
  57.         glob
  58.         bsd_glob
  59.     ) ],
  60. );
  61.  
  62. $VERSION = '1.0';
  63.  
  64. sub import {
  65.     my $i = 1;
  66.     while ($i < @_) {
  67.     if ($_[$i] =~ /^:(case|nocase|globally)$/) {
  68.         splice(@_, $i, 1);
  69.         $DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case';
  70.         $DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase';
  71.         if ($1 eq 'globally') {
  72.         no warnings;
  73.         *CORE::GLOBAL::glob = \&File::Glob::csh_glob;
  74.         }
  75.         next;
  76.     }
  77.     ++$i;
  78.     }
  79.     goto &Exporter::import;
  80. }
  81.  
  82. sub AUTOLOAD {
  83.     # This AUTOLOAD is used to 'autoload' constants from the constant()
  84.     # XS function.  If a constant is not found then control is passed
  85.     # to the AUTOLOAD in AutoLoader.
  86.  
  87.     my $constname;
  88.     ($constname = $AUTOLOAD) =~ s/.*:://;
  89.     local $! = 0;
  90.     my $val = constant($constname, @_ ? $_[0] : 0);
  91.     if ($! != 0) {
  92.     if ($! =~ /Invalid/) {
  93.         $AutoLoader::AUTOLOAD = $AUTOLOAD;
  94.         goto &AutoLoader::AUTOLOAD;
  95.     }
  96.     else {
  97.         croak "Your vendor has not defined File::Glob macro $constname";
  98.     }
  99.     }
  100.     eval "sub $AUTOLOAD { $val }";
  101.     goto &$AUTOLOAD;
  102. }
  103.  
  104. XSLoader::load 'File::Glob', $VERSION;
  105.  
  106. # Preloaded methods go here.
  107.  
  108. sub GLOB_ERROR {
  109.     return constant('GLOB_ERROR', 0);
  110. }
  111.  
  112. sub GLOB_CSH () {
  113.     GLOB_BRACE()
  114.     | GLOB_NOMAGIC()
  115.     | GLOB_QUOTE()
  116.     | GLOB_TILDE()
  117.     | GLOB_ALPHASORT()
  118. }
  119.  
  120. $DEFAULT_FLAGS = GLOB_CSH();
  121. if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
  122.     $DEFAULT_FLAGS |= GLOB_NOCASE();
  123. }
  124.  
  125. # Autoload methods go after =cut, and are processed by the autosplit program.
  126.  
  127. sub bsd_glob {
  128.     my ($pat,$flags) = @_;
  129.     $flags = $DEFAULT_FLAGS if @_ < 2;
  130.     return doglob($pat,$flags);
  131. }
  132.  
  133. # File::Glob::glob() is deprecated because its prototype is different from
  134. # CORE::glob() (use bsd_glob() instead)
  135. sub glob {
  136.     goto &bsd_glob;
  137. }
  138.  
  139. ## borrowed heavily from gsar's File::DosGlob
  140. my %iter;
  141. my %entries;
  142.  
  143. sub csh_glob {
  144.     my $pat = shift;
  145.     my $cxix = shift;
  146.     my @pat;
  147.  
  148.     # glob without args defaults to $_
  149.     $pat = $_ unless defined $pat;
  150.  
  151.     # extract patterns
  152.     $pat =~ s/^\s+//;    # Protect against empty elements in
  153.     $pat =~ s/\s+$//;    # things like < *.c> and <*.c >.
  154.             # These alone shouldn't trigger ParseWords.
  155.     if ($pat =~ /\s/) {
  156.         # XXX this is needed for compatibility with the csh
  157.     # implementation in Perl.  Need to support a flag
  158.     # to disable this behavior.
  159.     require Text::ParseWords;
  160.     @pat = Text::ParseWords::parse_line('\s+',0,$pat);
  161.     }
  162.  
  163.     # assume global context if not provided one
  164.     $cxix = '_G_' unless defined $cxix;
  165.     $iter{$cxix} = 0 unless exists $iter{$cxix};
  166.  
  167.     # if we're just beginning, do it all first
  168.     if ($iter{$cxix} == 0) {
  169.     if (@pat) {
  170.         $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ];
  171.     }
  172.     else {
  173.         $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ];
  174.     }
  175.     }
  176.  
  177.     # chuck it all out, quick or slow
  178.     if (wantarray) {
  179.         delete $iter{$cxix};
  180.         return @{delete $entries{$cxix}};
  181.     }
  182.     else {
  183.         if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
  184.             return shift @{$entries{$cxix}};
  185.         }
  186.         else {
  187.             # return undef for EOL
  188.             delete $iter{$cxix};
  189.             delete $entries{$cxix};
  190.             return undef;
  191.         }
  192.     }
  193. }
  194.  
  195. 1;
  196. __END__
  197.  
  198. =head1 NAME
  199.  
  200. File::Glob - Perl extension for BSD glob routine
  201.  
  202. =head1 SYNOPSIS
  203.  
  204.   use File::Glob ':glob';
  205.   @list = bsd_glob('*.[ch]');
  206.   $homedir = bsd_glob('~gnat', GLOB_TILDE | GLOB_ERR);
  207.   if (GLOB_ERROR) {
  208.     # an error occurred reading $homedir
  209.   }
  210.  
  211.   ## override the core glob (CORE::glob() does this automatically
  212.   ## by default anyway, since v5.6.0)
  213.   use File::Glob ':globally';
  214.   my @sources = <*.{c,h,y}>
  215.  
  216.   ## override the core glob, forcing case sensitivity
  217.   use File::Glob qw(:globally :case);
  218.   my @sources = <*.{c,h,y}>
  219.  
  220.   ## override the core glob forcing case insensitivity
  221.   use File::Glob qw(:globally :nocase);
  222.   my @sources = <*.{c,h,y}>
  223.  
  224. =head1 DESCRIPTION
  225.  
  226. File::Glob::bsd_glob() implements the FreeBSD glob(3) routine, which is
  227. a superset of the POSIX glob() (described in IEEE Std 1003.2 "POSIX.2").
  228. bsd_glob() takes a mandatory C<pattern> argument, and an optional
  229. C<flags> argument, and returns a list of filenames matching the
  230. pattern, with interpretation of the pattern modified by the C<flags>
  231. variable.
  232.  
  233. Since v5.6.0, Perl's CORE::glob() is implemented in terms of bsd_glob().
  234. Note that they don't share the same prototype--CORE::glob() only accepts
  235. a single argument.  Due to historical reasons, CORE::glob() will also
  236. split its argument on whitespace, treating it as multiple patterns,
  237. whereas bsd_glob() considers them as one pattern.
  238.  
  239. The POSIX defined flags for bsd_glob() are:
  240.  
  241. =over 4
  242.  
  243. =item C<GLOB_ERR>
  244.  
  245. Force bsd_glob() to return an error when it encounters a directory it
  246. cannot open or read.  Ordinarily bsd_glob() continues to find matches.
  247.  
  248. =item C<GLOB_LIMIT>
  249.  
  250. Make bsd_glob() return an error (GLOB_NOSPACE) when the pattern expands
  251. to a size bigger than the system constant C<ARG_MAX> (usually found in
  252. limits.h).  If your system does not define this constant, bsd_glob() uses
  253. C<sysconf(_SC_ARG_MAX)> or C<_POSIX_ARG_MAX> where available (in that
  254. order).  You can inspect these values using the standard C<POSIX>
  255. extension.
  256.  
  257. =item C<GLOB_MARK>
  258.  
  259. Each pathname that is a directory that matches the pattern has a slash
  260. appended.
  261.  
  262. =item C<GLOB_NOCASE>
  263.  
  264. By default, file names are assumed to be case sensitive; this flag
  265. makes bsd_glob() treat case differences as not significant.
  266.  
  267. =item C<GLOB_NOCHECK>
  268.  
  269. If the pattern does not match any pathname, then bsd_glob() returns a list
  270. consisting of only the pattern.  If C<GLOB_QUOTE> is set, its effect
  271. is present in the pattern returned.
  272.  
  273. =item C<GLOB_NOSORT>
  274.  
  275. By default, the pathnames are sorted in ascending ASCII order; this
  276. flag prevents that sorting (speeding up bsd_glob()).
  277.  
  278. =back
  279.  
  280. The FreeBSD extensions to the POSIX standard are the following flags:
  281.  
  282. =over 4
  283.  
  284. =item C<GLOB_BRACE>
  285.  
  286. Pre-process the string to expand C<{pat,pat,...}> strings like csh(1).
  287. The pattern '{}' is left unexpanded for historical reasons (and csh(1)
  288. does the same thing to ease typing of find(1) patterns).
  289.  
  290. =item C<GLOB_NOMAGIC>
  291.  
  292. Same as C<GLOB_NOCHECK> but it only returns the pattern if it does not
  293. contain any of the special characters "*", "?" or "[".  C<NOMAGIC> is
  294. provided to simplify implementing the historic csh(1) globbing
  295. behaviour and should probably not be used anywhere else.
  296.  
  297. =item C<GLOB_QUOTE>
  298.  
  299. Use the backslash ('\') character for quoting: every occurrence of a
  300. backslash followed by a character in the pattern is replaced by that
  301. character, avoiding any special interpretation of the character.
  302. (But see below for exceptions on DOSISH systems).
  303.  
  304. =item C<GLOB_TILDE>
  305.  
  306. Expand patterns that start with '~' to user name home directories.
  307.  
  308. =item C<GLOB_CSH>
  309.  
  310. For convenience, C<GLOB_CSH> is a synonym for
  311. C<GLOB_BRACE | GLOB_NOMAGIC | GLOB_QUOTE | GLOB_TILDE | GLOB_ALPHASORT>.
  312.  
  313. =back
  314.  
  315. The POSIX provided C<GLOB_APPEND>, C<GLOB_DOOFFS>, and the FreeBSD
  316. extensions C<GLOB_ALTDIRFUNC>, and C<GLOB_MAGCHAR> flags have not been
  317. implemented in the Perl version because they involve more complex
  318. interaction with the underlying C structures.
  319.  
  320. The following flag has been added in the Perl implementation for
  321. compatibility with common flavors of csh:
  322.  
  323. =over 4
  324.  
  325. =item C<GLOB_ALPHASORT>
  326.  
  327. If C<GLOB_NOSORT> is not in effect, sort filenames is alphabetical
  328. order (case does not matter) rather than in ASCII order.
  329.  
  330. =back
  331.  
  332. =head1 DIAGNOSTICS
  333.  
  334. bsd_glob() returns a list of matching paths, possibly zero length.  If an
  335. error occurred, &File::Glob::GLOB_ERROR will be non-zero and C<$!> will be
  336. set.  &File::Glob::GLOB_ERROR is guaranteed to be zero if no error occurred,
  337. or one of the following values otherwise:
  338.  
  339. =over 4
  340.  
  341. =item C<GLOB_NOSPACE>
  342.  
  343. An attempt to allocate memory failed.
  344.  
  345. =item C<GLOB_ABEND>
  346.  
  347. The glob was stopped because an error was encountered.
  348.  
  349. =back
  350.  
  351. In the case where bsd_glob() has found some matching paths, but is
  352. interrupted by an error, it will return a list of filenames B<and>
  353. set &File::Glob::ERROR.
  354.  
  355. Note that bsd_glob() deviates from POSIX and FreeBSD glob(3) behaviour
  356. by not considering C<ENOENT> and C<ENOTDIR> as errors - bsd_glob() will
  357. continue processing despite those errors, unless the C<GLOB_ERR> flag is
  358. set.
  359.  
  360. Be aware that all filenames returned from File::Glob are tainted.
  361.  
  362. =head1 NOTES
  363.  
  364. =over 4
  365.  
  366. =item *
  367.  
  368. If you want to use multiple patterns, e.g. C<bsd_glob "a* b*">, you should
  369. probably throw them in a set as in C<bsd_glob "{a*,b*}">.  This is because
  370. the argument to bsd_glob() isn't subjected to parsing by the C shell.
  371. Remember that you can use a backslash to escape things.
  372.  
  373. =item *
  374.  
  375. On DOSISH systems, backslash is a valid directory separator character.
  376. In this case, use of backslash as a quoting character (via GLOB_QUOTE)
  377. interferes with the use of backslash as a directory separator. The
  378. best (simplest, most portable) solution is to use forward slashes for
  379. directory separators, and backslashes for quoting. However, this does
  380. not match "normal practice" on these systems. As a concession to user
  381. expectation, therefore, backslashes (under GLOB_QUOTE) only quote the
  382. glob metacharacters '[', ']', '{', '}', '-', '~', and backslash itself.
  383. All other backslashes are passed through unchanged.
  384.  
  385. =item *
  386.  
  387. Win32 users should use the real slash.  If you really want to use
  388. backslashes, consider using Sarathy's File::DosGlob, which comes with
  389. the standard Perl distribution.
  390.  
  391. =item *
  392.  
  393. Mac OS (Classic) users should note a few differences. Since
  394. Mac OS is not Unix, when the glob code encounters a tilde glob (e.g.
  395. ~user/foo) and the C<GLOB_TILDE> flag is used, it simply returns that
  396. pattern without doing any expansion.
  397.  
  398. Glob on Mac OS is case-insensitive by default (if you don't use any
  399. flags). If you specify any flags at all and still want glob
  400. to be case-insensitive, you must include C<GLOB_NOCASE> in the flags.
  401.  
  402. The path separator is ':' (aka colon), not '/' (aka slash). Mac OS users
  403. should be careful about specifying relative pathnames. While a full path
  404. always begins with a volume name, a relative pathname should always
  405. begin with a ':'.  If specifying a volume name only, a trailing ':' is
  406. required.
  407.  
  408. =back
  409.  
  410. =head1 AUTHOR
  411.  
  412. The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
  413. and is released under the artistic license.  Further modifications were
  414. made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt>, Gurusamy Sarathy
  415. E<lt>gsar@activestate.comE<gt>, and Thomas Wegner
  416. E<lt>wegner_thomas@yahoo.comE<gt>.  The C glob code has the
  417. following copyright:
  418.  
  419.     Copyright (c) 1989, 1993 The Regents of the University of California.
  420.     All rights reserved.
  421.  
  422.     This code is derived from software contributed to Berkeley by
  423.     Guido van Rossum.
  424.  
  425.     Redistribution and use in source and binary forms, with or without
  426.     modification, are permitted provided that the following conditions
  427.     are met:
  428.  
  429.     1. Redistributions of source code must retain the above copyright
  430.        notice, this list of conditions and the following disclaimer.
  431.     2. Redistributions in binary form must reproduce the above copyright
  432.        notice, this list of conditions and the following disclaimer in the
  433.        documentation and/or other materials provided with the distribution.
  434.     3. Neither the name of the University nor the names of its contributors
  435.        may be used to endorse or promote products derived from this software
  436.        without specific prior written permission.
  437.  
  438.     THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
  439.     ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  440.     IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  441.     ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  442.     FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  443.     DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  444.     OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  445.     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  446.     LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  447.     OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  448.     SUCH DAMAGE.
  449.  
  450. =cut
  451.